home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / w3-print.el < prev    next >
Encoding:
Text File  |  1995-06-16  |  8.4 KB  |  216 lines
  1. ;;; w3-print.el,v --- Printing support for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/06/14 23:09:18
  4. ;; Version: 1.12
  5. ;; Keywords: faces, help, printing, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993, 1994 by William M. Perry (wmperry@spry.com)
  9. ;;;
  10. ;;; This file is part of GNU Emacs.
  11. ;;;
  12. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;;; it under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 2, or (at your option)
  15. ;;; any later version.
  16. ;;;
  17. ;;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; You should have received a copy of the GNU General Public License
  23. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26. (defvar w3-use-ps-print nil
  27.   "*If non-nil, then printing will be done via the ps-print package by
  28. James C. Thompson <thompson@wg2.waii.com>.")
  29.  
  30. (defun w3-face-type (face)
  31.   "Return a list specifying what a face looks like.  ie: '(bold italic)"
  32.   (let ((font (or (face-font face) (face-font 'default)))
  33.     (retval nil))
  34.     (if (not (stringp font))
  35.     (setq font
  36.           (cond
  37.            ((and (fboundp 'fontp) (not (fontp font))) nil)
  38.            ((fboundp 'font-truename) (font-truename font))
  39.            ((fboundp 'font-name) (font-name font))
  40.            (t nil))))
  41.     (cond
  42.      ((not font) nil)
  43.      ((string-match "^-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-" font)
  44.       (let ((wght (substring font (match-beginning 3) (match-end 3)))
  45.         (slnt (substring font (match-beginning 4) (match-end 4))))
  46.     (if (string-match "bold" wght)
  47.         (setq retval (cons 'bold retval)))
  48.     (if (or (string-match "i" slnt) (string-match "o" slnt))
  49.         (setq retval (cons 'italic retval)))
  50.     (if (and (fboundp 'face-underline-p)
  51.          (face-underline-p face))
  52.         (setq retval (cons 'underline retval)))))
  53.      ((and (symbolp face) (string-match "bold" (symbol-name face)))
  54.       (setq retval '(bold)))
  55.      ((and (symbolp face) (string-match "italic" (symbol-name face)))
  56.       (setq retval '(italic)))
  57.      (t nil))
  58.     retval))
  59.  
  60. (defun w3-print-with-ps-print (&optional buffer function)
  61.   "Print a buffer using `ps-print-buffer-with-faces'.
  62. This function wraps `ps-print-buffer-with-faces' so that the w3 faces
  63. will be correctly listed in ps-bold-faces and ps-italic-faces"
  64.   (interactive)
  65.   (require 'ps-print)
  66.   (setq buffer (or buffer (current-buffer))
  67.     function (or function 'ps-print-buffer-with-faces))
  68.   (let ((ps-bold-faces ps-bold-faces)
  69.     (ps-italic-faces ps-italic-faces)
  70.     (ps-underline-faces (cond
  71.                  ((boundp 'ps-underline-faces)
  72.                   (symbol-value 'ps-underline-faces))
  73.                  ((boundp 'ps-underlined-faces)
  74.                   (symbol-value 'ps-underlined-faces))
  75.                  (t nil)))
  76.     (ps-underlined-faces nil)
  77.     (ps-left-header '(ps-get-buffer-name url-view-url))
  78.     (faces (face-list))
  79.     (data nil)
  80.     (face nil))
  81.     (if (string< ps-print-version "1.6")
  82.     (while faces
  83.       (setq face (car faces)
  84.         data (w3-face-type face)
  85.         faces (cdr faces))
  86.       (if (and (memq 'bold data) (not (memq face ps-bold-faces)))
  87.           (setq ps-bold-faces (cons face ps-bold-faces)))
  88.       (if (and (memq 'italic data) (not (memq face ps-italic-faces)))
  89.           (setq ps-italic-faces (cons face ps-italic-faces)))
  90.       (if (and (memq 'underline data) (not (memq face ps-underline-faces)))
  91.           (setq ps-underline-faces (cons face ps-underline-faces))))
  92.       (setq ps-underlined-faces ps-underline-faces))
  93.     (save-excursion
  94.       (set-buffer buffer)
  95.       (funcall function))))
  96.  
  97. (defun w3-print-this-url (&optional url format)
  98.   "Print out the current document (in LaTeX format)"
  99.   (interactive)
  100.   (if (not url) (setq url (url-view-url t)))
  101.   (let* ((completion-ignore-case t)
  102.      (format (or format
  103.              (completing-read
  104.               "Format: "
  105.               '(("HTML Source")        ; The raw HTML code
  106.             ("Formatted Text")     ; Plain ASCII rendition
  107.             ("PostScript")        ; Pretty PostScript
  108.             ("LaTeX'd")        ; LaTeX it, then print
  109.             )
  110.               nil t))))
  111.     (save-excursion
  112.       (cond
  113.        ((equal "HTML Source" format)
  114.     (if w3-current-source
  115.         (let ((x w3-current-source))
  116.           (set-buffer (get-buffer-create url-working-buffer))
  117.           (erase-buffer)
  118.           (insert x))
  119.       (url-retrieve url))
  120.     (lpr-buffer))
  121.        ((or (equal "Formatted Text" format)
  122.         (equal "" format))
  123.     (lpr-buffer))
  124.        ((equal "PostScript" format)
  125.     (w3-print-with-ps-print (current-buffer)))
  126.        ((equal "LaTeX'd" format)
  127.     (if w3-current-source
  128.         (let ((x w3-current-source))
  129.           (set-buffer (get-buffer-create url-working-buffer))
  130.           (erase-buffer)
  131.           (insert x))
  132.       (url-retrieve url))
  133.     (w3-convert-html-to-latex)
  134.     (save-window-excursion
  135.       (write-region (point-min) (point-max)
  136.             (expand-file-name "w3-tmp.latex"
  137.                       w3-temporary-directory) nil 5)
  138.       (shell-command
  139.        (format
  140.         "cd %s ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*"
  141.         w3-temporary-directory
  142.         w3-print-command))
  143.       (kill-buffer "*Shell Command Output*")))))))
  144.  
  145. (defun w3-print-url-under-point ()
  146.   "Print out the url under point (in LaTeX format)"
  147.   (interactive)
  148.   (w3-print-this-url (w3-view-this-url t)))
  149.  
  150. (defun w3-convert-html-to-latex ()
  151.   ;; Convert an html document into LaTeX - this is pretty much the same as the
  152.   ;; sed scripts from ftp.w3.org"
  153.   (set-buffer url-working-buffer)
  154.   (if w3-use-html2latex
  155.       (shell-command-on-region (point-min) (point-max)
  156.                    (format "%s %s" w3-html2latex-prog
  157.                        w3-html2latex-args) t)
  158.     (let ((case-fold-search t))
  159.       (goto-char (point-min))
  160.       (w3-replace-regexp "\\\\" "\\\\backslash ")
  161.       (w3-replace-regexp "{" "\\\\{")
  162.       (w3-replace-regexp "}" "\\\\}")
  163.       (goto-char (point-min))
  164.       (w3-insert (concat "\\documentstyle" w3-latex-docstyle "\n"))
  165.       (w3-insert "\\begin{document}\n")
  166.       (goto-char (point-max))
  167.       (w3-insert "\\end{document}")
  168.       (w3-replace-regexp "<\\(XMP\\|LISTING\\)>" "\\\\begin{verbatim}")
  169.       (w3-replace-regexp "</\\(XMP\\|LISTING\\)>" "\\\\end{verbatim}")
  170.       (w3-replace-regexp "<\\(ISINDEX\\|NEXTID\\)[^>]*>" "")
  171.       (w3-replace-regexp (regexp-quote "$") "\\\\$")
  172.       (w3-replace-regexp (regexp-quote ">") "$>$")
  173.       (w3-replace-regexp "%" "\\\\%")
  174.       (w3-replace-regexp "#" "\\\\#")
  175.       (w3-replace-regexp "_" "\\\\_")
  176.       (w3-replace-regexp "~" "\\\\~")
  177.       (w3-replace-regexp "<LI> *" "\\\\item ")
  178.       (w3-replace-regexp (regexp-quote "^") "\\\\^")
  179.       (w3-replace-regexp "<P>" "\\\\par")
  180.       (w3-replace-regexp "<TITLE>\\([^<]*\\)</TITLE>" "\\\\section{\\1}")
  181.       (w3-replace-regexp "<IMG *SRC=\"\\([^\"]*.ps\\)\">"
  182.              "\\\\psfig{figure=\\1,width=\\\\columnwidth}")
  183.       (w3-replace-regexp "<H1>" "\\\\section{")
  184.       (w3-replace-regexp "<H2>" "\\\\subsection{")
  185.       (w3-replace-regexp "<H3>" "\\\\subsubsection{")
  186.       (w3-replace-regexp "<H4>" "\\\\subsubsection{")
  187.       (w3-replace-regexp "<H5>" "\\\\paragraph{")
  188.       (w3-replace-regexp "<H6>" "\\\\subparagraph{")
  189.       (w3-replace-regexp "</H[0-9]*>" "}")
  190.       (w3-replace-regexp "<\\(UL\\|DIR\\|MENU\\)>" "\\\\begin{itemize}")
  191.       (w3-replace-regexp "</\\(UL\\|DIR\\|MENU\\)>" "\\\\end{itemize}")
  192.       (w3-replace-regexp "<OL>" "\\\\begin{enumerate}")
  193.       (w3-replace-regexp "</OL>" "\\\\end{enumerate}")
  194.       (w3-replace-regexp "<DL>" "\\\\begin{description}")
  195.       (w3-replace-regexp "</DL>" "\\\\end{description}")
  196.       (w3-replace-regexp "<DT>\\([^<]*$\\)" "\\\\item[\\1]")
  197.       (w3-replace-regexp "<DD>" "")
  198.       (w3-replace-regexp "<A[ \t\n]+[^>]*>" "")   ;; get rid of anchors
  199.       (w3-replace-regexp "</A>" "")
  200.       (w3-replace-regexp
  201.        "<\\(EM\\|B\\|STRONG\\|DFN\\)>\\([^<]*\\)</\\(EM\\|B\\|STRONG\\|DFN\\)>"
  202.        "{\\\\bf \\2}")
  203.       (w3-replace-regexp
  204.        "<\\(CODE\\|SAMP\\|TT\\|KBD\\|VAR\\)>\\([^<]*\\)</\\(CODE\\|SAMP\\|TT\\|KBD\\|VAR\\)>"
  205.        "{\\\\tt \\2}")
  206.       (w3-replace-regexp
  207.        "<\\(CITE\\|U\\)>\\([^<]*\\)</\\(CITE\\|U\\)>" "{\\\\underline \\2}")
  208.       (w3-replace-regexp
  209.        "<\\(I\\|ADDRESS\\)>\\([^<]*\\)</\\(I\\|ADDRESS\\)>" "{\\\\it \\2}")
  210.       (w3-replace-regexp "<IMG[^>]*>" "")
  211.       (w3-replace-regexp (regexp-quote "<") "$<$")
  212.       (w3-replace-regexp (regexp-quote "&") " and ")
  213.       (w3-replace-regexp "<[^>]*>" ""))))
  214.  
  215. (provide 'w3-print)
  216.